home *** CD-ROM | disk | FTP | other *** search
- ;;; nntp.el --- GNUS interface to NNTP servers
-
- ;;; Copyright (C) 1993, 1994 Free Software Foundation, Inc.
- ;;;
- ;; Author: Felix Lee <flee@cse.psu.edu>
- ;; Version: !Id: nntp.el,v 1.10 1993/02/04 18:23:39 flee Exp !
- ;; Modified by jwz.
-
- ;; This file is part of XEmacs.
-
- ;; XEmacs is free software; you can redistribute it and/or modify it
- ;; under the terms of the GNU General Public License as published by
- ;; the Free Software Foundation; either version 2, or (at your option)
- ;; any later version.
-
- ;; XEmacs is distributed in the hope that it will be useful, but
- ;; WITHOUT ANY WARRANTY; without even the implied warranty of
- ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
- ;; General Public License for more details.
-
- ;; You should have received a copy of the GNU General Public License
- ;; along with XEmacs; see the file COPYING. If not, write to the Free
- ;; Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
-
- ;;; Code:
-
- (require 'gnus) ; for the (poorly named) 'nntp-' accessor macros.
- (require 'chat)
- (or (fboundp 'open-network-stream) (require 'tcp))
-
- (defvar nntp/rcs-revision (purecopy "!Revision: 1.10.3 !"))
-
- (defvar nntp/default-nntp-port (purecopy "nntp")
- "The default tcp port to use for nntp connections.")
-
- (defun nntp-last (x)
- "Returns the last link in the list LIST."
- (while (cdr x)
- (setq x (cdr x)))
- x)
-
- ;;;;;;;;;;;;;;;;
- ;;; NNTP state.
-
- ;; Right now, we're assuming we only talk to one NNTP server at a
- ;; time. It might be nice to do multiple NNTP connections, but
- ;; there's no point in doing this from the bottom up.
-
- ;; (To handle multiple connections, you need to create connection
- ;; handles that you pass around. Ideally, nnspool et al would be
- ;; just different types of connection handles.)
-
- (defvar nntp/connection nil
- "The current NNTP connection.")
-
- ;; XEmacs addition
- (defvar nntp/group nil
- "The most-recently-selected NNTP group.")
-
- ;;; jwz: call this nntp-status-string instead of nntp/error-message because
- ;;; existing code uses that variable (in particular, nnspool.el and mhspool.el
- ;;; set it.)
- (defvar nntp-status-string nil
- "The error message from the last NNTP command. 'nil if no error.
- Don't use this, call the function `nntp-status-message' instead.")
-
- (defvar nntp/can-xover t
- "Does this server understand the XOVER command? (Computed.)")
-
- ;; XEmacs addition
- (defvar nntp/inhibit-xover nil
- "If you have XOVER but it doesn't work, set this to t.")
-
- ;;;;;;;;;;;;;;;;
- ;;; The GNUS interface.
-
- ;; These are the symbols that GNUS knows about and expects.
-
- ;; The interaction between GNUS and nntp.el (or nnspool.el) is a
- ;; little messy and not particularly well defined.
-
- (defvar nntp-version
- (purecopy
- (concat "flee/nntp/Lucid " (substring nntp/rcs-revision 11 -2))))
-
- (defvar nntp-server-buffer nil
- "Buffer that GNUS looks at when it wants data.")
-
- ;; XEmacs addition
- (defvar nntp-authinfo-string nil
- "*String sent to NNTP server if the connection fails.")
-
- (defun nntp-open-server (host service)
- "Start a connection to the given HOST and SERVICE. Returns true
- if successful."
- ;; XXX already open?
- (or service (setq service nntp/default-nntp-port))
- (setq nntp-status-string nil)
- (setq nntp/can-xover (not nntp/inhibit-xover)) ; XEmacs change
- (setq nntp-server-buffer (generate-new-buffer "*nntp*"))
- ;;(buffer-flush-undo nntp-server-buffer)
- (buffer-disable-undo nntp-server-buffer)
- (setq nntp/group nil) ; XEmacs addition
- (setq nntp/connection
- (open-network-stream "nntp" nntp-server-buffer host service))
- (set-process-sentinel nntp/connection 'nntp/sentinel)
- (process-kill-without-query nntp/connection)
-
- (let ((code (nntp/response)))
-
- ;; XEmacs addition: with some INN servers, we need to do this to convince
- ;; it to behave in the conventional way and not assume we want to do a
- ;; batch transfer of news. With older NNTP servers, this will provoke a
- ;; "500 unknown command", which we can simply ignore.
- (nntp/command "MODE READER")
- (nntp/response) ; ignored.
-
- (or (eq code 200) (eq code 201)
- ;; XEmacs change: if it fails, send AUTHINFO and try once more.
- (and nntp-authinfo-string
- (progn
- (nntp/command "AUTHINFO" nntp-authinfo-string)
- (setq code (nntp/response))
- (or (eq code 200) (eq code 201)))))))
-
-
- (defun nntp-server-opened ()
- "Are we currently connected?"
- ;; if the buffer has died on us, kill all the rest.
- (if (and nntp/connection
- (or (null nntp-server-buffer)
- (null (buffer-name nntp-server-buffer))))
- (nntp-close-server))
- (and nntp/connection
- (memq (process-status nntp/connection) '(run open))))
- ;; XXX should we add stopped to this list?
-
- (defun nntp-close-server ()
- "Terminate the connection. Returns nothing."
- (let ((proc nntp/connection)
- (buffer nntp-server-buffer))
- (setq nntp/connection nil)
- (setq nntp/group nil) ; XEmacs addition
- (setq nntp-server-buffer nil)
- (and proc (delete-process proc))
- (and buffer (kill-buffer buffer))))
-
- (defun nntp-status-message ()
- "Returns the error message from the last NNTP request."
- ;; jwz: return "" instead of "okay" just in case old code expected that.
- (or nntp-status-string ""))
-
- (defun nntp-request-list ()
- "Retrieve the list of newsgroups into 'nntp-server-buffer.
- Returns true if successful."
- (nntp/command "LIST")
- (if (eq (nntp/response) 215)
- ;; We don't do any text format conversion here. It's wasted
- ;; effort, since the text needs to be parsed by GNUS anyway.
- (nntp/wait-for-text)))
-
- (defun nntp-request-group (group)
- "Select group GROUP. Returns true if successful."
- (nntp/command "GROUP" group)
- (if (not (eq (nntp/response) 211))
- nil
- (setq nntp/group group) ; XEmacs addition
- t))
-
- (defun nntp-request-article (id)
- "Retrieve article ID (either a number or a message-id) into
- 'nntp-server-buffer. Returns true if successful."
- (and (numberp id) (setq id (int-to-string id)))
- (nntp/command "ARTICLE" id)
- (if (eq (nntp/response) 220)
- (nntp/get-text)))
-
- (defun nntp-request-post ()
- "Modify and post the current buffer. Returns true if successful."
- ;; The trick here is we want to make sure the conversation is in a
- ;; sane state even if we're interrupted in middle of transmission.
- ;; Right now, we just prematurely terminate the posting. While this
- ;; isn't ideal, it's better than continually adding junk to the end.
- ;; The problem is NNTP doesn't let you abort a posting.
- ;; XXX A better approach is to open a new connection for posting,
- ;; but this is going to be slower, unless you anticipate the user by
- ;; opening the connection early.
- (nntp/command "POST")
- (if (eq (nntp/response) 340)
- (let ( (finished nil) )
- (unwind-protect
- (progn
- (nntp/unix-to-smtp-text)
- (process-send-region nntp/connection (point-min) (point-max))
- (setq finished t)
- (eq (nntp/response) 240))
- (or finished
- (process-send-string nntp/connection "\r\n.\r\n")
- nil)))))
-
- ;; XEmacs: ckd addition to support by-ID retrieval
- (defun nntp-retrieve-headers-by-id (messageid)
- "Returns the header data for MESSAGE-ID.
- MESSAGE-ID is a string like \"<12345@foo.com>\"."
- (and messageid
- (let ((result nil))
- (message "NNTP: retrieving headers...")
- ;; ckd: strictly speaking, nntp/headers wants a sequence but the
- ;; underlying NNTP command (HEAD) doesn't actually care, so this
- ;; still works.
- (setq result (nntp/headers messageid))
- (message "NNTP: retrieving headers...done")
- result)))
-
- (defun nntp-retrieve-headers (sequence)
- "Returns the header data for SEQUENCE in the current group.
- SEQUENCE is a sorted list of article numbers.
- XXX describe the return value."
- (and sequence
- (let ((result nil))
- (message "NNTP: retrieving headers...")
- (if nntp/can-xover
- (setq result (nntp/try-xover sequence)))
- (if (not nntp/can-xover)
- (setq result (nntp/headers sequence)))
- (message "NNTP: retrieving headers...done")
- result)))
-
- ;;;;;;;;;;;;;;;;
- ;;; Talking to the NNTP server.
-
- (defun nntp/sentinel (proc delta)
- (or (nntp-server-opened)
- (error "NNTP connection closed.")))
-
- (defun nntp/clear ()
- ;; XXX This resynchronization is imperfect, but is probably good
- ;; enough for normal use.
- (chat/delete-pending-data nntp/connection))
-
- (defun nntp/command (&rest strings)
- "Start a new NNTP command."
- (nntp/clear)
- (process-send-string
- nntp/connection
- (concat (mapconcat 'identity strings " ") "\r\n")))
-
- ;;;;;;;;;;;;;;;;
- ;;; Reading from the NNTP server.
-
- ;; This is almost 4x faster than (string-to-int (buffer-substring ... ))
- ;; primarily because of garbage collection. -jwz
- (defmacro nntp/read-integer (&optional point move-p)
- (` ((, (if move-p 'progn 'save-excursion))
- (,@ (if point (list (list 'goto-char point))))
- (if (and (<= (following-char) ?9)
- (>= (following-char) ?0))
- (read (current-buffer))
- 0))))
-
- (defun nntp/response ()
- "Wait for an NNTP response and return the response code. Also sets
- 'nntp-status-string."
- ;; XXX Emacs 18.xx has a bug that turns undo back on after a gc, so
- ;; we continually flush undo here.
- ;;(buffer-flush-undo nntp-server-buffer)
- (chat/with-data-until-string "\n" nntp/connection
- (let ((code (nntp/read-integer (point-min))))
- ;; Codes 400 and up are error conditions.
- (setq nntp-status-string
- (and (<= 400 code)
- (buffer-substring (+ (point-min) 4) (- (point-max) 2))))
- code)))
-
- (defun nntp/wait-for-text ()
- "Wait for an NNTP text response. Returns true."
- (chat/wait-for-dot-crlf nntp/connection))
-
- (defun nntp/get-text ()
- "Wait for an NNTP text response and convert it to Unix text format.
- Returns true."
- (nntp/wait-for-text)
- (save-excursion
- (set-buffer nntp-server-buffer)
- (nntp/smtp-to-unix-text))
- t)
-
- ;;;;;;;;;;;;;;;;
- ;;; Handling the funny dot-CRLF text format used by SMTP/NNTP.
-
- (defun nntp/smtp-to-unix-text ()
- "Convert the current buffer from SMTP text format to Unix text
- format. Modifies point. Returns nothing."
- (goto-char (point-min))
- (while (not (eobp))
- (if (eq (following-char) ?.)
- (delete-char 1))
- (end-of-line)
- (if (eq (preceding-char) ?\r)
- (delete-char -1))
- (forward-char))
- ;; Delete the last line, which had the dot-crlf terminator.
- (backward-char)
- (if (eq (preceding-char) ?\n)
- (delete-char 1))
- )
-
- (defun nntp/unix-to-smtp-text ()
- "Convert the current buffer form Unix text format to SMTP text
- format. Modifies point. Returns nothing."
- (goto-char (point-min))
- (while (not (eobp))
- (if (eq (following-char) ?.)
- (insert ?.))
- (end-of-line)
- (insert ?\r)
- (forward-line))
- ;; Add the terminator, but first insert a CRLF if necessary.
- (or (bobp)
- (eq (preceding-char) ?\n)
- (insert "\r\n"))
- (insert ".\r\n"))
-
- ;;;;;;;;;;;;;;;;
- ;;; Fetch headers using XOVER.
-
- ;; XXX We could probably try splitting a sequence into segments and
- ;; sending multiple XOVER commands, one for each segment. However,
- ;; this is a little more expensive for the news server to process, and
- ;; mostly just reduces network traffic. There isn't much difference
- ;; in response, unless you're in the habit of leaving 100+ article
- ;; gaps. A couple hundred extra overview lines are unnoticeable on a
- ;; Sun SLC.
-
- ;; XXX In general, maybe we should have a gap threshhold: if a gap is
- ;; larger than N, split it into two XOVER requests, but the actual
- ;; tradeoffs are more complex than that. This is really a flaw in
- ;; XOVER; you should be able to give XOVER a monotonically increasing
- ;; sequence of ranges, which is something that can be processed
- ;; efficiently.
-
- ;; XXX There's an unhappy synchronization problem here with C News.
- ;; The bounds in the active file are updated before the overview data
- ;; is updated, which may not happen until minutes later. If you read
- ;; the active file and enter a newsgroup soon after it receives new
- ;; articles, then the overview fetch will leave out the new articles.
- ;; GNUS will wrongly conclude that the articles don't exist, mark them
- ;; as read, and you'll never see them.
-
- (defun nntp/try-xover (sequence)
- "Try using the XOVER command to retrieve headers."
- (let ((lo (car sequence))
- (hi (car (nntp-last sequence))))
- (nntp/command "XOVER" (concat (int-to-string lo) "-" (int-to-string hi)))
- (if (eq (nntp/response) 224)
- (chat/with-data-until-dot-crlf nntp/connection
- (nov/parse sequence))
- (setq nntp/can-xover nil)
- nil)))
-
- ;;;;;;;;;;;;;;;;
- ;;; News overview parsing.
-
- ;; XXX This section isn't really nntp-specific. It probably could be
- ;; a separate module by itself.
-
- ;; Small changes to this code can have large impact on performance.
-
- ;; You'd think that using skip-chars-forward would be faster than
- ;; search-forward, but for some reason it ends up marginally slower.
- ;; I suspect it's because the setup overhead for both is about the
- ;; same, but the inner loop for search-forward is much more carefully
- ;; coded.
-
- (defmacro nov/skip-field ()
- '(search-forward "\t" eol 'end))
-
- (defmacro nov/field ()
- '(buffer-substring
- (point)
- (progn (nov/skip-field) (1- (point)))))
-
- (defun nov/parse (sequence)
- "Parse the news overview data in the current buffer, and return a
- list of headers that match SEQUENCE (see 'nntp-retrieve-headers)."
- (let ( (number nil)
- (header nil)
- (headers nil)
- (eol nil) )
- (goto-char (point-min))
- (while (and sequence (not (eobp)))
- (setq number (nntp/read-integer nil t))
-
- ;; INN can report XOVER information *if* it is set up to do so.
- ;; However, if it is not configured to do so, instead of replying
- ;; to XOVER with some status code that we can detect, it responds
- ;; with 224. However, the data that it returns is useless to us:
- ;; it's just a list of article numbers, with no other fields
- ;; present.
- ;;
- ;; So, if after reading the number, the next character is not a
- ;; tab, we must be in this state. At that point, give up on XOVER
- ;; and return nil.
- ;;
- ;; However, a working XOVER server will return an empty response
- ;; for articles which don't exist - compare to the above-bug, which
- ;; returns a line containing only an article number. Be careful
- ;; not to turn off XOVER in that case.
- ;;
- ;; ckd says that this bug is fixed in INN 1.4 and later: nnrpd
- ;; will generate XOVER information the fly if there is no overview
- ;; file.
- ;;
- (if (not (= (following-char) ?\t))
- (if (= (following-char) ?.)
- ;; EXCEPT if the next character is "." which means we are at
- ;; the end of the XOVER data. In that case we probably tried
- ;; to get a cancelled article. Clear the sequence and exit.--ckd
- (progn
- (setq sequence nil)
- (goto-char (point-max)))
- ;; We're losing.
- (setq sequence nil
- headers nil
- nntp/can-xover nil)
- (goto-char (point-max))
- )
-
- ;; else, the XOVER data appears to be for real.
-
- (while (and sequence (< (car sequence) number))
- (setq sequence (cdr sequence)))
- (if (and sequence (eq number (car sequence)))
- (progn
- (setq sequence (cdr sequence))
- (save-excursion
- (end-of-line)
- (setq eol (point)))
- ;; header: [num subject from xref lines date id refs]
- ;; overview: [num subject from date id refs lines chars misc]
- (setq header (make-vector 8 nil))
- (nntp-set-header-number header number)
- (forward-char) ; move past the "\t"
- (nntp-set-header-subject header (nov/field))
- (nntp-set-header-from header (nov/field))
- (nntp-set-header-date header (nov/field))
- (nntp-set-header-id header (nov/field))
- (nntp-set-header-references header (nov/field))
- (nov/skip-field)
- ;; #### this could benefit from using nntp/read-integer
- (nntp-set-header-lines header (string-to-int (nov/field)))
- (backward-char)
- (if (search-forward "\txref: " eol t)
- (nntp-set-header-xref header (nov/field)))
- (setq headers (cons header headers))
- ))
- (forward-line)
- )
- )
- (setq headers (nreverse headers))
- headers))
-
- ;;;;;;;;;;;;;;;;
- ;;; A workaround for missing Xrefs in the overview data.
-
- ;(defun nntp/add-to-hook (hook-name value)
- ; (let ((hook nil))
- ; (if (boundp hook-name)
- ; (setq hook (symbol-value hook-name)))
- ; (if (or (subrp hook)
- ; (and hook (symbolp hook))
- ; (and (listp hook) (eq (car hook) 'lambda)))
- ; (setq hook (list hook)))
- ; (or (memq value hook)
- ; (setq hook (cons value hook)))
- ; (set hook-name hook)))
-
- ;(nntp/add-to-hook
- ; 'gnus-Article-prepare-hook
- ; 'nntp/article-get-xrefs)
-
- (add-hook 'gnus-article-prepare-hook 'nntp/article-get-xrefs)
-
-
- (defvar gnus-current-headers nil) ; from gnus.el
-
- (defun nntp/article-get-xrefs ()
- "Fill in the Xref value in 'gnus-current-headers, if necessary.
- This is meant to be called in 'gnus-Article-prepare-hook."
- (or gnus-digest-mode
- (nntp-header-xref gnus-current-headers)
- (let ((case-fold-search t)) ;XEmacs, was nil
- (goto-char (point-min))
- (search-forward "\n\n" nil 'end)
- (save-restriction
- (narrow-to-region (point-min) (point))
- (goto-char (point-min))
- (if (or (and (eq (downcase (following-char)) ?x)
- (looking-at "Xref:"))
- (search-forward "\nXref:" nil t))
- (progn
- (goto-char (match-end 0))
- (forward-char)
- (aset gnus-current-headers 3
- (buffer-substring
- (point) (progn (end-of-line) (point))))
- ))))))
-
- ;;;;;;;;;;;;;;;;
- ;;; Fetch headers using HEAD.
-
- (defun nntp/headers (sequence)
- (nntp/clear)
- (nntp/send-head-requests sequence)
- (nntp/parse-headers sequence))
-
- (defun nntp/send-head-requests (sequence)
- (message "NNTP: requesting headers...")
- (let ((L (length sequence))
- (count 0))
- (while sequence
- (process-send-string
- nntp/connection
- (concat "HEAD " (car sequence) "\r\n"))
- (if (= 0 (% count 5000))
- (gnus-lazy-message "NNTP: requesting headers... %d%%" (/ count L)))
-
- ;; XEmacs change: in order to avoid a potential deadlock, it is necessary
- ;; to synchronize with the server occasionally. At first I thought to do
- ;; this by ressurecting the `nntp-maximum-request' variable, but that
- ;; seems not to be enough. Consider the following situation:
- ;; - send N "head" requests
- ;; - wait for a reply; get a bunch of lines back for the first N/2
- ;; requests. As soon as no more input is available (because the
- ;; the server has momentarily stopped sending for whatever reason)
- ;; we continue
- ;; - send N more "head" requests
- ;; - get back another N/2 responses.
- ;; In this way, we can easily fill up the buffer between us and the
- ;; server, and get a deadlock, no matter what the value of
- ;; `nntp-maximum-request' so long as it is greater than one.
- ;;
- ;; So, after each HEAD request, we wait for a reply for that request.
- ;; This stinks. It would be better to send N head requests, and then
- ;; block waiting for N responses to come in. However, the current
- ;; structure of this code (in particular the implementation of
- ;; nntp/parse-headers, using chat/with-data-until-string) makes that
- ;; tricky.
- ;;
- ;; XEmacs: no focus-change surprises here
- (save-excursion (accept-process-output nntp/connection))
-
- (setq count (+ count 100))
- (setq sequence (cdr sequence))))
- )
-
- (defun nntp/parse-headers (sequence)
- (message "NNTP: parsing headers...")
- (let ((headers nil)
- (code nil)
- (L (length sequence))
- (count 0))
- (while sequence
- (chat/with-data-until-string "\n" nntp/connection
- (setq code (nntp/read-integer (point-min))))
- (if (eq code 221)
- (chat/with-data-until-dot-crlf nntp/connection
- (setq headers (cons (nntp/parse-header (car sequence)) headers)))
- (chat/with-buffer-of nntp/connection ; jwz: added this
- (forward-line)))
- (if (= 0 (% count 5000))
- (gnus-lazy-message "NNTP: parsing headers... %d%%" (/ count L)))
- (setq count (+ count 100))
- (setq sequence (cdr sequence)))
- (nreverse headers)))
-
- ;;; #### should this be inline?
- (defun nntp/header-value ()
- (goto-char (match-end 0))
- (skip-chars-forward "\t ")
- (buffer-substring
- (point)
- (progn
- (while
- (progn
- (end-of-line)
- (if (eq (preceding-char) ?\r)
- (delete-char -1))
- (forward-char)
- (memq (following-char) '(?\t ? )))
- (delete-char -1)
- (delete-char 1)
- (insert ? ))
- (1- (point))))
- )
-
- (defun nntp/parse-header (number)
- (let ((header (make-vector 8 nil))
- (case-fold-search t)
- char)
- ;; The old nntp.el used to always use 0 as the message number of
- ;; articles which were requested by message-id. It might make more
- ;; sense to put the message-id in there, but it breaks things. --jwz
- (aset header 0 (if (numberp number) number 0))
-
- (aset header 4 0)
- (while (not (eobp))
- ;; header: [num subject from xref lines date id refs]
- (if (not (looking-at "subject:\\|from:\\|xref:\\|lines:\\|date:\\|message-id:\\|references:"))
- (forward-line)
- (setq char (downcase (following-char))) ; XEmacs addition
- (cond
- ((eq char ?s)
- (nntp-set-header-subject header (nntp/header-value)))
- ((eq char ?f)
- (nntp-set-header-from header (nntp/header-value)))
- ((eq char ?x)
- (nntp-set-header-xref header (nntp/header-value)))
- ((eq char ?l)
- ;; #### this could benefit from using nntp/read-integer
- (nntp-set-header-lines header (string-to-int (nntp/header-value))))
- ((eq char ?d)
- (nntp-set-header-date header (nntp/header-value)))
- ((eq char ?m)
- (nntp-set-header-id header (nntp/header-value)))
- ((eq char ?r)
- (nntp-set-header-references header (nntp/header-value)))
- ))
- )
- ;; XEmacs addition: must have a subject and sender.
- (or (nntp-header-subject header) (nntp-set-header-subject header ""))
- (or (nntp-header-from header) (nntp-set-header-from header ""))
-
- ;; XEmacs addition: if this article was requested by message id, try to
- ;; figure out what its article number in the current group is. This can
- ;; only succeed if the article is a crosspost, or if this NNTP server adds
- ;; an "Xref:" field to all articles (some do.) In any event, if this can
- ;; succeed, it returns a more meaningful result, so give it a try. The
- ;; consing and funcalls in here are not a big deal because the only time
- ;; articles are retrieved by message-id is when we're only getting a
- ;; single article.
- (and (not (numberp number))
- (stringp (nntp-header-xref header))
- nntp/group
- (string-match (concat "[ \t]"
- (regexp-quote nntp/group)
- ":\\([0-9]+\\)")
- (nntp-header-xref header))
- (setq number
- (aset header 0 (car (read-from-string (nntp-header-xref header)
- (match-beginning 1)
- (match-end 1))))))
-
- ;; XEmacs change from ckd: if the XPATH command is available, it will give
- ;; us a list of paths for the article. This means even if it is only
- ;; posted to one group, and has no Xref, if that group is the current
- ;; group then we can get a useful article number. XPATH response is in
- ;; the form '223 alt/foo/bar/350 alt/baz/ugh/1023'. This serves as an
- ;; extra fallback for the 'Xref' trick above. XXX this code will do the
- ;; wrong thing with alt.foo.bar if there also exists an alt.foo-bar group
- ;; (because it uses the group name's dots as regexp characters). We
- ;; really should change . to / and use regexp-quote, but I haven't coded
- ;; that part yet -- ckd 930124
- ;;
- ;; jwz asks: what NNTP servers always provide Xref, and which provide
- ;; XPATH (and is that standardized at all) and is ther any overlap?
- ;;
- ;; Ok, I've disabled this because it breaks the world when -retrieve-headers
- ;; or -retrieve-headers-by-id are called with more than one message ID. You
- ;; can't go and issue another command before you're done parsing the rest on
- ;; the queue because that throws all that data away!! -jwz
- ; (and (not (numberp number))
- ; (let ((code nil)
- ; (response-string nil))
- ; (and (= 0 (aref header 0))
- ; nntp/group
- ; (progn
- ; (nntp/command "XPATH" (aref header 6))
- ; ;; we can't use nntp/response since we need the text of
- ; ;; the line
- ; (chat/with-data-until-string
- ; "\n" nntp/connection
- ; (setq code (nntp/read-integer (point-min))
- ; response-string
- ; (concat " "
- ; (buffer-substring (+ (point-min) 4)
- ; (- (point-max) 2))
- ; " "))))
- ; (eq code 223)
- ; (string-match (concat " " nntp/group "/\\([0-9]+\\) ")
- ; response-string)
- ; (aset header 0 (car (read-from-string response-string
- ; (match-beginning 1)
- ; (match-end 1)))))))
- header))
-
- ;;; ADDED for gnus3.15
-
- (defun nntp-request-list-newsgroups ()
- "List newsgroups (defined in NNTP2)."
- (nntp/command "LIST NEWSGROUPS")
- (if (eq (nntp/response) 215)
- (nntp/wait-for-text)))
-
- (defun nntp-request-list-distributions ()
- "List distributions (defined in NNTP2)."
- (nntp/command "LIST DISTRIBUTIONS")
- (if (eq (nntp/response) 215)
- (nntp/wait-for-text)))
-
- (provide 'nntp)
-
- ;;; nntp.el ends here
-